home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Just Call Me Internet
/
Just Call Me Internet.iso
/
prog
/
atari
/
m2
/
cat3src
/
cat
/
confvars.i
< prev
next >
Wrap
Text File
|
1997-10-26
|
30KB
|
991 lines
IMPLEMENTATION MODULE ConfVars;
FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE;
FROM GrafBase IMPORT Rectangle;
FROM Storage IMPORT ALLOCATE, DEALLOCATE, MemSize;
(*
FROM InOut IMPORT WriteString, WriteInt, WriteLn, Read;
*)
FROM Void IMPORT v;
IMPORT Lists;
IMPORT Strings;
IMPORT StrConv;
IMPORT BinOps;
IMPORT MagicAES;
IMPORT mtAlerts;
IMPORT mtTextfiles;
IMPORT Characters;
IMPORT FileNames;
CONST configVersion = '1.3 Dec 16 1996,';
copyRight = ' ½ 1992-1997 Dirk Steins';
whatString = '@(#)ConfigVars ' + configVersion+copyRight+0C;
equalSignCol = 30;
configRequest = 'ConfigRequestFile';
TYPE MaxStr = ARRAY [0..511] OF CHAR;
strPtr = POINTER TO MaxStr;
varType = (noVar, comment, int, lint, string, rect, bool);
varVal = RECORD CASE : varType OF
int : intV : INTEGER; |
lint : lintV: LONGINT; |
string : strV : strPtr; |
rect : rectV : Rectangle; |
bool : boolV : BOOLEAN; |
END;
END;
confVar = RECORD
type : varType;
val : varVal;
name : MaxStr;
END;
varPtr = POINTER TO confVar;
TYPE ErrorIndicator = (noBool, noInt, noRect, noString, syntaxErr, typeErr);
VAR confVars : Lists.List;
normalVars,
tmpVars : Lists.List;
deskSize : Rectangle;
reqF : BOOLEAN;
reqFile : mtTextfiles.TEXTFILE;
(*$Z-*)
PROCEDURE findName (entry : ADDRESS; info : ADDRESS) : BOOLEAN;
VAR theVar : varPtr;
theName: strPtr;
BEGIN
theVar := varPtr (entry);
theName := strPtr (info);
RETURN Strings.StrEqual (theVar^.name, theName^);
END findName;
(*$Z=*)
(*$W-*)
PROCEDURE findConfVar (REF name : ARRAY OF CHAR; VAR var : varPtr) : BOOLEAN;
VAR found : BOOLEAN;
BEGIN
Lists.ResetList (confVars);
Lists.ScanEntries (confVars, Lists.forward, findName, ADR (name), found);
IF found THEN
var := varPtr (Lists.CurrentEntry (confVars));
ELSE
var := NIL;
END;
RETURN found & (var # NIL);
END findConfVar;
(*$W+*)
(* Umrechnungsprozeduren *)
CONST ndcBase = 32767.0;
PROCEDURE RC2NDC (VAR r : Rectangle);
VAR tw, th : REAL;
PROCEDURE LowerReal (x, y : REAL): REAL;
BEGIN
IF x > y THEN RETURN y ELSE RETURN x END;
END LowerReal;
BEGIN
tw := FLOAT(deskSize.x + deskSize.w);
th := FLOAT(deskSize.y + deskSize.h);
WITH r DO
x := VAL (INTEGER, LowerReal (ndcBase, (ndcBase / tw) * FLOAT(x)));
y := VAL (INTEGER, LowerReal (ndcBase, (ndcBase / th) * FLOAT(y)));
w := VAL (INTEGER, LowerReal (ndcBase, (ndcBase / tw) * FLOAT(w)));
h := VAL (INTEGER, LowerReal (ndcBase, (ndcBase / th) * FLOAT(h)));
END;
END RC2NDC;
PROCEDURE NDC2RC (VAR r : Rectangle);
VAR tw, th : REAL;
BEGIN
tw := FLOAT(deskSize.x + deskSize.w);
th := FLOAT(deskSize.y + deskSize.h);
WITH r DO
x := VAL (INTEGER, 0.5 + (FLOAT(x) * tw) / ndcBase);
y := VAL (INTEGER, 0.5 + (FLOAT(y) * th) / ndcBase);
w := VAL (INTEGER, 0.5 + (FLOAT(w) * tw) / ndcBase);
h := VAL (INTEGER, 0.5 + (FLOAT(h) * th) / ndcBase);
END;
END NDC2RC;
PROCEDURE setVar (theVar : confVar) : BOOLEAN;
(* verndert eine vorhandene Variable oder erzeugt eine neue
*)
VAR newVar : varPtr;
BEGIN
IF ~findConfVar (theVar.name, newVar)
THEN
ALLOCATE (newVar, TSIZE (varType)+TSIZE (varVal) + LONG(LENGTH (theVar.name)+1));
IF newVar = NIL
THEN RETURN FALSE
END;
newVar^.type := theVar.type;
newVar^.val := theVar.val;
Strings.Assign (theVar.name, newVar^.name, v.bool);
Lists.AppendEntry (confVars, newVar, v.bool);
IF v.bool THEN RETURN FALSE END;
ELSE
IF (newVar^.type = lint)
& (theVar.type = int)
THEN
(* Kompatibilitt von lInt und int *)
newVar^.type := theVar.type;
newVar^.val := theVar.val;
RETURN TRUE;
ELSIF (newVar^.type = int)
& (theVar.type = lint)
THEN
(* Bereichsprfung und dann zuweisen *)
newVar^.type := theVar.type;
newVar^.val := theVar.val;
ELSIF newVar^.type # theVar.type THEN
RETURN FALSE
END;
IF theVar.type = string
THEN
DEALLOCATE (newVar^.val.strV, 0);
newVar^.val.strV := theVar.val.strV;
ELSE
newVar^.val := theVar.val;
END;
END;
RETURN TRUE;
END setVar;
PROCEDURE prep (REF in: ARRAY OF CHAR; VAR name, arg : ARRAY OF CHAR);
VAR tmp : ARRAY [0..255] OF CHAR;
i : INTEGER;
len : INTEGER;
BEGIN
(* Anpassung an Whitespace *)
i := 0;
len := LENGTH (in);
WHILE ( NOT Characters.IsSpace(in[i])) & (i < len) DO INC (i); END;
Strings.Split (in, i , name,arg, v.bool);
Strings.DelLeadingBlanks (arg);
Strings.Split (arg, Strings.PosLen ('=',arg,0)+1,tmp, arg, v.bool);
IF arg[0] = 0C THEN Strings.Assign (tmp, arg, v.bool) END;
Strings.DelLeadingBlanks (arg);
(* YYYY Hier noch Semikolon-Abfrage ndern *)
Strings.Split (arg, Strings.PosLen (';',arg,0),arg, tmp, v.bool);
Strings.DelLeadingBlanks (arg);
Strings.DelTrailingBlanks (arg);
END prep;
PROCEDURE getNameAndType (REF line : ARRAY OF CHAR;
VAR name, argStr : ARRAY OF CHAR;
errorType : ErrorIndicator) : varType;
VAR theType : varType;
BEGIN
prep (line, name, argStr);
IF (name[0] = ';') OR (name[0] = '#') OR (name[0] = 0C) THEN RETURN comment END;
IF (argStr[0] = 0C) THEN
errorType := syntaxErr; RETURN noVar
END;
theType := noVar;
CASE argStr[0] OF
'0'..'9',
'-' : (* int gefunden *)
theType := lint;|
'{' : (* Rectangle *)
theType := rect; |
'O',
'T',
'F' : (* Boolean *)
theType := bool; |
'"',
"'" : IF argStr[0] = argStr[LENGTH(argStr)-1]
THEN
theType := string
END;
ELSE
END;
IF theType = noVar THEN errorType := typeErr END;
RETURN theType;
END getNameAndType;
PROCEDURE processLine (REF fname, line : ARRAY OF CHAR; lineNumber : INTEGER) : BOOLEAN;
VAR theVar : confVar;
newVar : varPtr; (* Dieser wird alloziert *)
error : BOOLEAN;
errorType : ErrorIndicator;
alt : MaxStr;
argStr,
valStr : ARRAY [0..511] OF CHAR;
PROCEDURE getInfoBool (REF arg : ARRAY OF CHAR; VAR o : BOOLEAN);
BEGIN
IF Strings.StrEqual ('ON', arg) OR Strings.StrEqual ('TRUE', arg)
THEN o := TRUE
ELSIF Strings.StrEqual ('OFF', arg) OR Strings.StrEqual ('FALSE', arg)
THEN o := FALSE;
ELSE
error := TRUE;
errorType := noBool;
END;
END getInfoBool;
PROCEDURE getInfoInt (REF arg : ARRAY OF CHAR; VAR l: LONGINT);
VAR i: CARDINAL;
t: LONGINT;
BEGIN
i:= 0;
t:= StrConv.StrToLInt (arg, i, v.bool);
IF ~v.bool
THEN
error := TRUE;
errorType := noInt;
END;
l := t;
END getInfoInt;
PROCEDURE getInfoRect (REF arg : ARRAY OF CHAR; VAR r : Rectangle);
VAR p, i : CARDINAL;
ra : ARRAY [0..3] OF INTEGER;
BEGIN
p := 0; (* pos *)
FOR i := 0 TO 3 DO
WHILE (arg[p] = ' ') OR (arg[p] = '{') OR (arg[p]=',') DO INC (p) END;
ra[i] := StrConv.StrToInt (arg, p, v.bool);
IF ~v.bool
THEN
error := TRUE;
errorType := noRect;
RETURN
END;
END;
r.x := ra[0];
r.y := ra[1];
r.w := ra[2];
r.h := ra[3];
NDC2RC(r);
IF r.x + r.w < deskSize.x THEN r.x := deskSize.x END;
IF r.x > deskSize.x+deskSize.w THEN r.x := deskSize.x+deskSize.w-40 END;
IF r.y < deskSize.y THEN r.y := deskSize.y END;
IF r.y > deskSize.y+deskSize.h THEN r.y := deskSize.y+deskSize.h-40 END;
IF r.w < 0 THEN r.w := 80 END;
r.w := BinOps.LowerInt (r.w, deskSize.w);
IF r.h < 0 THEN r.h := 120 END;
r.h := BinOps.LowerInt (r.h, deskSize.h);
END getInfoRect;
PROCEDURE getInfoStr (arg : ARRAY OF CHAR; VAR str : ARRAY OF CHAR);
VAR pos : INTEGER;
numStr : ARRAY [0..9] OF CHAR;
p1 : CARDINAL;
BEGIN
IF LENGTH (arg) > 0
THEN
arg[LENGTH(arg)-1] := 0C; (* hinteres Anfhrungszeichen lschen *)
Strings.Delete (arg, 0, 1, v.bool); (* vorderes Anfhrungszeichen lschen *)
Strings.Assign (arg,str, v.bool);
(* Sonderzeichen bersetzen *)
pos := 0;
WHILE pos >= 0 DO
pos := Strings.Pos ('\', str, pos);
IF pos >= 0
THEN
(* Feststellen, ob die nchsten drei Zahlen sind *)
Strings.Copy (str, pos+1, 3, numStr, v.bool);
IF Characters.IsDigit (numStr[0])
& Characters.IsDigit (numStr[1])
& Characters.IsDigit (numStr[2])
THEN
Strings.Delete (str, pos, 4, v.bool);
p1 := 0;
Strings.Insert (CHR(StrConv.StrToCard (numStr, p1, v.bool)), pos, str, v.bool);
ELSIF (numStr[0] = '\')
THEN
(* Ein \ entfernen *)
Strings.Delete (str, pos, 1, v.bool);
INC(pos);
ELSE
INC(pos);
END;
END;
END;
ELSE
error := TRUE;
errorType := noString;
END;
END getInfoStr;
BEGIN
error := FALSE;
CASE getNameAndType (line, theVar.name, argStr, errorType) OF
lint : getInfoInt (argStr, theVar.val.lintV);
IF (theVar.val.lintV <= 32767) & (theVar.val.lintV >= -32768)
THEN
theVar.val.intV := SHORT(theVar.val.lintV);
theVar.type := int;
ELSE
theVar.type := lint;
END;|
bool : getInfoBool (argStr, theVar.val.boolV); theVar.type := bool; |
rect : getInfoRect (argStr, theVar.val.rectV); theVar.type := rect; |
string: getInfoStr (argStr, valStr);
IF ~error THEN
ALLOCATE (theVar.val.strV, LENGTH (valStr)+1);
IF theVar.val.strV = NIL THEN RETURN FALSE END;
Strings.Assign (valStr, theVar.val.strV^, v.bool);
theVar.type := string;
END; |
comment: RETURN TRUE |
ELSE
error := TRUE;
END;
IF error
THEN
(* Fehlermeldung ausgeben *)
Strings.Assign ('[3][CAT:|Fehler in INF-File|',alt, v.bool);
Strings.Append (fname, alt, v.bool);
Strings.Append (':|', alt, v.bool);
CASE errorType OF
noInt : Strings.Append ('Keine Integerzahl',alt, v.bool); |
noBool : Strings.Append ('Kein Boolean ',alt, v.bool); |
noString : Strings.Append ('Kein String',alt, v.bool); |
noRect : Strings.Append ('Kein Rechteck',alt, v.bool); |
syntaxErr: Strings.Append ('Syntaxfehler', alt, v.bool); |
typeErr : Strings.Append ('Typ nicht erkannt', alt, v.bool); |
ELSE
END;
Strings.Append ('|in Zeile: ',alt, v.bool);
Strings.Append (StrConv.IntToStr (lineNumber,0), alt, v.bool);
Strings.Append ('][ [OK ]', alt, v.bool);
mtAlerts.SetIconColor (MagicAES.RED);
v.int := mtAlerts.Alert (1,alt);
RETURN TRUE;
END;
(* Variable richtig eingelesen, also weitermachen *)
RETURN setVar (theVar);
END processLine;
PROCEDURE buildBool (value: BOOLEAN; VAR str: ARRAY OF CHAR);
BEGIN
IF value THEN Strings.Assign ('TRUE', str, v.bool);
ELSE Strings.Assign ('FALSE', str, v.bool);
END;
END buildBool;
PROCEDURE writeName (inf: mtTextfiles.TEXTFILE; REF name: ARRAY OF CHAR);
BEGIN
mtTextfiles.WriteLine (inf,name);
mtTextfiles.WriteLine (inf, Strings.Space (BinOps.HigherInt (1, INTEGER(equalSignCol)-INTEGER(Strings.Length(name)))));
mtTextfiles.WriteLine (inf, ' := ');
END writeName;
(*$W-*)
PROCEDURE writeInfoBool (inf : mtTextfiles.TEXTFILE; REF name : ARRAY OF CHAR; value : BOOLEAN);
VAR str : MaxStr;
BEGIN
writeName (inf,name);
buildBool (value, str);
mtTextfiles.WriteLine (inf, str);
mtTextfiles.WriteChar (inf, ';');
mtTextfiles.WriteLn(inf);
END writeInfoBool;
PROCEDURE writeInfoInt (inf : mtTextfiles.TEXTFILE; REF name : ARRAY OF CHAR; value : LONGINT);
BEGIN
writeName (inf, name);
mtTextfiles.WriteLongInt (inf, value, 0);
mtTextfiles.WriteChar (inf, ';');
mtTextfiles.WriteLn(inf);
END writeInfoInt;
PROCEDURE buildStr (REF value: ARRAY OF CHAR; VAR str: ARRAY OF CHAR);
VAR val : ARRAY [0..511] OF CHAR;
num : ARRAY [0..9] OF CHAR;
i, j: INTEGER;
BEGIN
IF LENGTH (value) > 0
THEN
(* Sonderzeichen in String bersetzen *)
j := 0;
FOR i := 0 TO INTEGER(LENGTH (value))-1 DO
IF (ORD(value[i]) >= 32) & (value[i] # ';')
THEN
val[j] := value[i];
IF (val[j] = '\')
THEN
(* '\' verdoppeln *)
INC (j);
val[j] := '\';
END;
INC (j);
ELSE
val[j] := '\';
Strings.Assign (StrConv.NumToStr(ORD(value[i]), 10, 3, '0'), num, v.bool);
val[j+1] := num[0];
val[j+2] := num[1];
val[j+3] := num[2];
INC (j, 4);
END;
END (* FOR *);
val[j] := 0C;
Strings.Assign (val, str, v.bool);
ELSE
Strings.Assign ("", str, v.bool);
END;
END buildStr;
PROCEDURE writeInfoStr (inf : mtTextfiles.TEXTFILE; REF name : ARRAY OF CHAR; REF value : ARRAY OF CHAR);
VAR str: MaxStr;
BEGIN
IF LENGTH (value) > 0
THEN
writeName (inf, name);
mtTextfiles.WriteLine (inf, '"');
buildStr (value, str);
mtTextfiles.WriteLine (inf, str);
mtTextfiles.WriteLine (inf, '";');
mtTextfiles.WriteLn(inf);
END;
END writeInfoStr;
PROCEDURE buildRectStr(value: Rectangle; VAR str: ARRAY OF CHAR);
BEGIN
Strings.Assign ('{', str, v.bool);
RC2NDC (value);
WITH value DO
Strings.Append (StrConv.IntToStr (x, 0), str, v.bool);
Strings.Append (', ', str, v.bool);
Strings.Append (StrConv.IntToStr (y, 0), str, v.bool);
Strings.Append (', ', str, v.bool);
Strings.Append (StrConv.IntToStr (w, 0), str, v.bool);
Strings.Append (', ', str, v.bool);
Strings.Append (StrConv.IntToStr (h, 0), str, v.bool);
Strings.Append ('}', str, v.bool);
END;
END buildRectStr;
PROCEDURE writeInfoRect (inf : mtTextfiles.TEXTFILE; REF name : ARRAY OF CHAR; value : Rectangle);
VAR str : MaxStr;
BEGIN
writeName (inf, name);
buildRectStr (value, str);
mtTextfiles.WriteLine (inf, str);
mtTextfiles.WriteLine (inf, ';');
mtTextfiles.WriteLn(inf);
END writeInfoRect;
(*$W=*)
PROCEDURE reqConfBool (REF name: ARRAY OF CHAR; VAR theVar: varPtr; withDef: BOOLEAN; def: BOOLEAN): BOOLEAN;
VAR found: BOOLEAN;
str : MaxStr;
BEGIN
found := findConfVar (name, theVar);
IF reqF
THEN
writeName (reqFile, name);
IF found
THEN
buildBool (theVar^.val.boolV, str);
mtTextfiles.WriteLine (reqFile, str);
END;
mtTextfiles.WriteLine (reqFile, ';');
mtTextfiles.WriteLine (reqFile, ' [');
IF withDef
THEN
buildBool (def, str);
mtTextfiles.WriteLine (reqFile, str);
END;
mtTextfiles.WriteLine (reqFile, ']');
mtTextfiles.WriteLn(reqFile);
END;
RETURN found;
END reqConfBool;
PROCEDURE reqConfStr (REF name: ARRAY OF CHAR; VAR theVar: varPtr; withDef: BOOLEAN; REF def: ARRAY OF CHAR): BOOLEAN;
VAR found: BOOLEAN;
str : MaxStr;
BEGIN
found := findConfVar (name, theVar);
IF reqF
THEN
writeName (reqFile, name);
IF found & (theVar^.type = string)
THEN
buildStr (theVar^.val.strV^, str);
mtTextfiles.WriteLine (reqFile, '"');
mtTextfiles.WriteLine (reqFile, str);
mtTextfiles.WriteLine (reqFile, '"');
END;
mtTextfiles.WriteLine (reqFile, ';');
mtTextfiles.WriteLine (reqFile, ' [');
IF withDef
THEN
buildStr (def, str);
mtTextfiles.WriteLine (reqFile, '"');
mtTextfiles.WriteLine (reqFile, str);
mtTextfiles.WriteLine (reqFile, '"');
END;
mtTextfiles.WriteLine (reqFile, ']');
mtTextfiles.WriteLn(reqFile);
END;
RETURN found;
END reqConfStr;
PROCEDURE reqConfInt (REF name: ARRAY OF CHAR; VAR theVar: varPtr; withDef: BOOLEAN; def: LONGINT): BOOLEAN;
VAR found: BOOLEAN;
str : MaxStr;
BEGIN
found := findConfVar (name, theVar);
IF reqF
THEN
writeName (reqFile, name);
IF found
THEN
IF theVar^.type = lint
THEN
mtTextfiles.WriteLongInt (reqFile, theVar^.val.lintV, 0);
ELSE
mtTextfiles.WriteLongInt (reqFile, theVar^.val.intV, 0);
END;
END;
mtTextfiles.WriteLine (reqFile, ';');
mtTextfiles.WriteLine (reqFile, ' [');
IF withDef
THEN
mtTextfiles.WriteLongInt (reqFile, def, 0);
END;
mtTextfiles.WriteLine (reqFile, ']');
mtTextfiles.WriteLn(reqFile);
END;
RETURN found;
END reqConfInt;
PROCEDURE reqConfRect (REF name: ARRAY OF CHAR; VAR theVar: varPtr; withDef: BOOLEAN; def: Rectangle): BOOLEAN;
VAR found: BOOLEAN;
str : MaxStr;
BEGIN
found := findConfVar (name, theVar);
IF reqF
THEN
writeName (reqFile, name);
IF found
THEN
buildRectStr (theVar^.val.rectV, str);
mtTextfiles.WriteLine (reqFile, str);
END;
mtTextfiles.WriteLine (reqFile, ';');
mtTextfiles.WriteLine (reqFile, ' [');
IF withDef
THEN
buildRectStr (def, str);
mtTextfiles.WriteLine (reqFile, str);
END;
mtTextfiles.WriteLine (reqFile, ']');
mtTextfiles.WriteLn(reqFile);
END;
RETURN found;
END reqConfRect;
(*
(*$Z-*)
VAR count : INTEGER;
bytes : LONGINT;
oBytes: LONGINT;
PROCEDURE countEntry (entry : ADDRESS; info: ADDRESS) : BOOLEAN;
VAR theVar : varPtr;
BEGIN
INC (count);
theVar := varPtr (entry);
INC (bytes, MemSize (entry)+10);
INC (bytes, TSIZE(Lists.LCarrier)+10);
INC (oBytes, 20); (* 10 Bytes pro Malloc *)
IF theVar^.type = string
THEN
INC (bytes, MemSize (theVar^.val.strV)+10);
INC (oBytes, 10);
END;
RETURN FALSE;
END countEntry;
(*$Z=*)
*)
(*$Z-*)
PROCEDURE writeEntry (entry : ADDRESS; info : ADDRESS) : BOOLEAN;
VAR theVar : varPtr;
inf : POINTER TO mtTextfiles.TEXTFILE;
BEGIN
theVar := varPtr (entry);
inf := info;
CASE theVar^.type OF
string : writeInfoStr (inf^, theVar^.name, theVar^.val.strV^); |
lint : writeInfoInt (inf^, theVar^.name, theVar^.val.lintV); |
int : writeInfoInt (inf^, theVar^.name, theVar^.val.intV); |
rect : writeInfoRect (inf^, theVar^.name, theVar^.val.rectV); |
bool : writeInfoBool (inf^, theVar^.name, theVar^.val.boolV); |
ELSE
END;
RETURN FALSE;
END writeEntry;
(*$Z=*)
(*-------- exportierte Funktionen ---------------*)
PROCEDURE GetConfigString (REF name : ARRAY OF CHAR; VAR val : ARRAY OF CHAR) : BOOLEAN;
VAR theVar : varPtr;
BEGIN
IF ~reqConfStr (name, theVar, FALSE, ''+0c) THEN RETURN FALSE END;
IF theVar^.type # string THEN RETURN FALSE END;
Strings.Assign (theVar^.val.strV^, val, v.bool);
RETURN TRUE;
END GetConfigString;
PROCEDURE GetConfigInt (REF name : ARRAY OF CHAR; VAR val : INTEGER): BOOLEAN;
VAR theVar : varPtr;
BEGIN
IF ~reqConfInt (name, theVar, FALSE, 0) THEN RETURN FALSE END;
IF (theVar^.type # int) & (theVar^.type # lint) THEN RETURN FALSE END;
IF (theVar^.type = lint) &
((theVar^.val.lintV > 32767) OR (theVar^.val.lintV < 32768))
THEN
RETURN FALSE
END;
IF theVar^.type = int
THEN
val := theVar^.val.intV;
ELSE
val := SHORT(theVar^.val.lintV);
END;
RETURN TRUE;
END GetConfigInt;
PROCEDURE GetConfigLongInt (REF name : ARRAY OF CHAR; VAR val : LONGINT): BOOLEAN;
VAR theVar : varPtr;
BEGIN
IF ~reqConfInt (name, theVar, FALSE, 0) THEN RETURN FALSE END;
IF (theVar^.type # int) & (theVar^.type # lint) THEN RETURN FALSE END;
IF theVar^.type = int
THEN
val := theVar^.val.intV;
ELSE
val := theVar^.val.lintV;
END;
RETURN TRUE;
END GetConfigLongInt;
PROCEDURE GetConfigBool (REF name : ARRAY OF CHAR; VAR val : BOOLEAN): BOOLEAN;
VAR theVar : varPtr;
BEGIN
IF ~reqConfBool (name, theVar, FALSE, FALSE) THEN RETURN FALSE END;
IF theVar^.type # bool THEN RETURN FALSE END;
val := theVar^.val.boolV;
RETURN TRUE;
END GetConfigBool;
PROCEDURE GetConfigRect (REF name : ARRAY OF CHAR; VAR val : Rectangle): BOOLEAN;
VAR theVar : varPtr;
BEGIN
IF ~reqConfRect (name, theVar, FALSE, Rectangle{0,0,0,0}) THEN RETURN FALSE END;
IF theVar^.type # rect THEN RETURN FALSE END;
val := theVar^.val.rectV;
RETURN TRUE;
END GetConfigRect;
(*------------- Variablen lesen mit Default-Wert -------------------*)
PROCEDURE GetConfDefStr (REF name : ARRAY OF CHAR; VAR val : ARRAY OF CHAR;
REF default : ARRAY OF CHAR);
(* Liest eine String-Variable. Wenn die Variable nicht gefunden wird,
* dann wird der Default-Wert zurckgegeben.
*)
VAR theVar : varPtr;
BEGIN
IF reqConfStr (name, theVar, TRUE, default) & (theVar^.type = string)
THEN
Strings.Assign (theVar^.val.strV^, val, v.bool);
ELSE
Strings.Assign (default, val, v.bool);
END;
END GetConfDefStr;
PROCEDURE GetConfDefInt (REF name : ARRAY OF CHAR; VAR val : INTEGER;
default : INTEGER);
(* Liest eine Integer-Variable. Wenn die Variable nicht gefunden wird,
* dann wird der Default-Wert zurckgegeben.
*)
VAR theVar : varPtr;
BEGIN
IF ~reqConfInt (name, theVar, TRUE, default) THEN val := default; RETURN END;
IF (theVar^.type # int) & (theVar^.type # lint) THEN val := default; RETURN END;
IF (theVar^.type = lint) &
((theVar^.val.lintV > 32767) OR (theVar^.val.lintV < 32768))
THEN
val := default;
RETURN
END;
IF theVar^.type = int
THEN
val := theVar^.val.intV;
ELSE
val := SHORT(theVar^.val.lintV);
END;
END GetConfDefInt;
PROCEDURE GetConfDefLongInt (REF name : ARRAY OF CHAR; VAR val : LONGINT;
default : LONGINT);
(* Liest eine Integer-Variable. Wenn die Variable nicht gefunden wird,
* dann wird der Default-Wert zurckgegeben.
*)
VAR theVar : varPtr;
BEGIN
IF ~reqConfInt (name, theVar, TRUE, default) THEN val := default; RETURN END;
IF (theVar^.type # int) & (theVar^.type # lint) THEN val := default; RETURN END;
IF theVar^.type = int
THEN
val := theVar^.val.intV;
ELSE
val := theVar^.val.lintV;
END;
END GetConfDefLongInt;
PROCEDURE GetConfDefBool (REF name : ARRAY OF CHAR; VAR val : BOOLEAN;
default : BOOLEAN);
(* Liest eine Bool'sche Variable. Wenn die Variable nicht gefunden wird,
* dann wird der Default-Wert zurckgegeben.
*)
VAR theVar : varPtr;
BEGIN
IF reqConfBool (name, theVar, TRUE, default) & (theVar^.type = bool)
THEN
val := theVar^.val.boolV;
ELSE
val := default;
END;
END GetConfDefBool;
PROCEDURE GetConfDefRect (REF name : ARRAY OF CHAR; VAR val : Rectangle;
default : Rectangle);
(* Liest eine Rechteck-Variable. Wenn die Variable nicht gefunden wird,
* dann wird der Default-Wert zurckgegeben.
*)
VAR theVar : varPtr;
BEGIN
IF reqConfRect (name, theVar, TRUE, default) & (theVar^.type = rect)
THEN
val := theVar^.val.rectV;
ELSE
val := default;
END;
END GetConfDefRect;
(*------------- Variablen schreiben -------------------*)
PROCEDURE SetConfigString (REF name : ARRAY OF CHAR; REF val : ARRAY OF CHAR) : BOOLEAN;
(* Schreibt eine String-Variable. Bei TRUE konnte die Variable angelegt werden.
*)
VAR theVar : confVar;
BEGIN
Strings.Assign (name, theVar.name, v.bool);
theVar.type := string;
ALLOCATE (theVar.val.strV, LENGTH (val)+1);
IF theVar.val.strV = NIL THEN RETURN FALSE END;
Strings.Assign (val, theVar.val.strV^, v.bool);
IF ~setVar (theVar)
THEN
DEALLOCATE (theVar.val.strV, 0);
RETURN FALSE;
END;
RETURN TRUE;
END SetConfigString;
PROCEDURE SetConfigInt (REF name : ARRAY OF CHAR; val : INTEGER): BOOLEAN;
(* Schreibt eine Integer-Variable. Bei TRUE konnte die Variable angelegt werden.
*)
VAR theVar : confVar;
BEGIN
Strings.Assign (name, theVar.name, v.bool);
theVar.type := int;
theVar.val.intV := val;
RETURN setVar (theVar);
END SetConfigInt;
PROCEDURE SetConfigLongInt (REF name : ARRAY OF CHAR; val : LONGINT): BOOLEAN;
(* Schreibt eine Integer-Variable. Bei TRUE konnte die Variable angelegt werden.
*)
VAR theVar : confVar;
BEGIN
Strings.Assign (name, theVar.name, v.bool);
theVar.type := lint;
theVar.val.lintV := val;
RETURN setVar (theVar);
END SetConfigLongInt;
PROCEDURE SetConfigBool (REF name : ARRAY OF CHAR; val : BOOLEAN): BOOLEAN;
(* Schreibt eine Bool'sche Variable. Bei TRUE konnte die Variable angelegt werden.
*)
VAR theVar : confVar;
BEGIN
Strings.Assign (name, theVar.name, v.bool);
theVar.type := bool;
theVar.val.boolV := val;
RETURN setVar (theVar);
END SetConfigBool;
PROCEDURE SetConfigRect (REF name : ARRAY OF CHAR; val : Rectangle ): BOOLEAN;
(* Schreibt eine Rechteck-Variable. Bei TRUE konnte die Variable angelegt werden.
*)
VAR theVar : confVar;
BEGIN
Strings.Assign (name, theVar.name, v.bool);
theVar.type := rect;
theVar.val.rectV := val;
RETURN setVar (theVar);
END SetConfigRect;
PROCEDURE DeleteConfigVar (REF name : ARRAY OF CHAR);
VAR theVar : varPtr;
BEGIN
IF findConfVar (name, theVar)
THEN
Lists.RemoveEntry (confVars, v.bool);
IF theVar^.type = string
THEN
DEALLOCATE (theVar^.val.strV, 0);
END;
DEALLOCATE (theVar, 0);
END;
END DeleteConfigVar;
PROCEDURE DeleteAllVars ();
VAR theVar : varPtr;
BEGIN
Lists.ResetList (confVars);
theVar := Lists.NextEntry (confVars);
WHILE theVar # NIL DO
Lists.RemoveEntry (confVars, v.bool);
IF theVar^.type = string
THEN
DEALLOCATE (theVar^.val.strV, 0);
END;
DEALLOCATE (theVar, 0);
theVar := Lists.NextEntry (confVars);
END;
END DeleteAllVars;
PROCEDURE CloseConfig ();
(* Wird aufgerufen, wenn das Programm beendet wird.
* Dadurch wird ein eventuell vorhandenes Request-File
* geschlossen
*)
BEGIN
IF reqF
THEN
mtTextfiles.CloseTextfile (reqFile);
END;
END CloseConfig;
(*------------- File I/O ------------------------- *)
PROCEDURE ReadConfigFile (REF filename : ARRAY OF CHAR) : BOOLEAN;
VAR inf : mtTextfiles.TEXTFILE;
cont: BOOLEAN;
line: INTEGER;
s : MaxStr;
fname : ARRAY [0..15] OF CHAR;
s2 : MaxStr;
req : BOOLEAN;
reqName: MaxStr;
BEGIN
IF ~mtTextfiles.OpenTextfile (filename, mtTextfiles.READ, 32768, inf)
THEN
RETURN FALSE
END;
FileNames.SplitPath (filename, s2, fname);
cont := TRUE;
line := 0;
REPEAT
mtTextfiles.ReadLine (inf, s);
mtTextfiles.ReadLn(inf);
INC(line);
cont := processLine (fname, s, line);
UNTIL mtTextfiles.EndofText (inf) OR ~cont;
IF ~cont THEN
v.int := mtAlerts.Alert (1,"[3][CAT:|Nicht genug Speicher|fr alle Config-Variablen!][ [OK ]");
END;
mtTextfiles.CloseTextfile (inf);
GetConfDefBool (configRequest, req, FALSE);
IF req
THEN
(* Filenamen zusammenbauen *)
FileNames.ConcatName (filename, 'req', reqName);
reqF := mtTextfiles.OpenTextfile (reqName, mtTextfiles.WRITE, 32768, reqFile);
END;
RETURN cont;
END ReadConfigFile;
PROCEDURE emptyInf( REF info: mtTextfiles.TEXTFILE);
(* Leere Infoproc, gibt nichts aus *)
END emptyInf;
PROCEDURE WriteConfigFile (REF filename : ARRAY OF CHAR; info: infoProc) : BOOLEAN;
VAR inf : mtTextfiles.TEXTFILE;
BEGIN
IF ~mtTextfiles.OpenTextfile (filename, mtTextfiles.WRITE, 32768, inf)
THEN
RETURN FALSE;
END;
info (inf);
mtTextfiles.WriteLine (inf, "# "+whatString);
mtTextfiles.WriteLn (inf);
Lists.ResetList (confVars);
Lists.ScanEntries (confVars, Lists.forward, writeEntry, ADR (inf), v.bool);
mtTextfiles.CloseTextfile (inf);
RETURN TRUE;
END WriteConfigFile;
PROCEDURE ConfigConfigModule (useTmpVars : BOOLEAN);
BEGIN
IF useTmpVars
THEN
confVars := tmpVars;
ELSE
confVars := normalVars;
END;
END ConfigConfigModule;
PROCEDURE SetConfigVarList (l : Lists.List);
(* Konfiguriert das Modul um, welche Variablenliste benutzt
* wird.
*)
BEGIN
confVars := l;
END SetConfigVarList;
PROCEDURE ResetConfigVarList ();
(* Setzt die interne Variablenliste wieder auf die
* normalen Configvariablen zurck.
*)
BEGIN
confVars := normalVars;
END ResetConfigVarList;
BEGIN
Lists.CreateList (normalVars, v.bool);
IF v.bool THEN HALT END;
confVars := normalVars;
Lists.CreateList (tmpVars, v.bool);
IF v.bool THEN HALT END;
MagicAES.WindGet (0, MagicAES.WFWORKXYWH, deskSize);
reqF := FALSE;
END ConfVars.